Belgian Amiga Club - ADF Collection/BS1 part 60.zip/BS1 part 60/protext d1.adf/Install_Protext

Text File | 1993-11-24 | 5KB | 215 lines

(welcome "Protext 6.1 Hard Disk Installation")

(procedure nothing (set dummy 0))

(set progdisk "Protext6-Program"
ppddisk "Protext6-Printers"
dictdisk "Protext6-Dictionary"
thesdisk "Protext6-Thesaurus"
m_plsinsert "\n\nPlease insert %s Disk"
)

; Need to init u-destpath and u-srcpath for this code

(procedure arnorcopydisk (
    (foreach u-srcpath "#?"
        (set u-docopy 0)
        (if (< @each-type 0)
            ( ; file, not a directory
                (set u-srcname (tackon u-srcpath @each-name))
                (if (patmatch "#?.((gpd)|(ppd))" @each-name)
                    (set u-destname (tackon (tackon u-destpath "ppd") @each-name))
                    (if (patmatch "#?.((lex)|(qic)|(exl)|(env)|(hyp)|(ths))" @each-name)
                        (set u-destname (tackon (tackon u-destpath "lex") @each-name))
                        (set u-destname (tackon u-destpath @each-name))
                    )
                )
                (if (or
                        (or (patmatch "((install#?)|(#?.bak))" @each-name)
                            (patmatch "((disk.info)|(.backdrop))" @each-name))
                        (and (patmatch "protext.cfg" @each-name)
                            (exists u-destname))
                    )
                    (set u-docopy 0)
                    (
                        (if (or (not g-update) (not (exists u-destname)))
                            (set u-docopy 1)
                            ( ; else dest does exist
                                (if (earlier u-srcname u-destname)
                                    (set u-docopy 0)
                                    (
                                        (if (<> (getsize u-destname)
                                                (getsize u-srcname)
                                            )
                                            (set u-docopy 2)
                                        )
                                    )
                                )
                            )
                        )
                    )
                )
            )
        )
        (if u-docopy
            (
                (copyfiles
                    (source u-srcname)
                    (dest (pathonly u-destname))
                )
                (if (patmatch "#?.info" @each-name)
                    (tooltype
                        (dest u-destname)
                        (noposition)
                    )
                )
            )
        )
    )
))


(procedure oldfilestuff (
    (set tmp (tackon @default-dest "ppd"))
    (if (exists tmp)
        (
            (delete (tackon tmp "#?.cpd"))
            (rename tmp (tackon @default-dest "ppd.old"))
        )
    )
))

(if
    (askbool
        (prompt "\nDo you want to carry out a full installation\n"
                "or update an existing version of Protext?\n\n"
                "Selecting `Full Installation' will copy all files.\n\n"
                "Selecting `Update' will only copy newer files on top of older files.\n\n"
                "Both options will preserve your configuration settings.")
        (help "No more help here")
        (choices "Full Installation" "Update Only")
    )
    (set g-update 0 g-msg "install")
    (set g-update 1 g-msg "update")
)

(set @default-dest (tackon @default-dest "Protext"))
(if (= 1 (exists @default-dest))
    (rename @default-dest (cat @default-dest ".old"))
)

(until space-ok
    (if
        (askbool
            (prompt
                ("\nSuggested installation drawer is %s" @default-dest)
            )
            (help "Select `Proceed' if this drawer is OK and has at least 3Mb of free disk space, otherwise select `Change' or `Abort'.")
            (choices "Proceed" "Change")
        )
        (nothing)
        (
            (set tmp
                (askdir
                    (prompt "Which drawer do you wish to install into?")
                    (help @askdir-help)
                    (default @default-dest)
                    (newpath)
                )
            )
            (if (= (substr tmp (- (strlen tmp) 1)) ":")
                (set tmp (tackon tmp "Protext"))
            )
            (set @default-dest tmp)
        )
    )
    (set space-ok (or g-update (>= (getdiskspace @default-dest) 3000000)))
    (if (not space-ok)
        (
            (if
                (askbool
                    (prompt "\n " (pathonly @default-dest)
                            " does not have 3Mb of free space on it.\n\n"
                            "If you are installing on top of an existing copy of Protext, "
                            "there may be enough disk space to proceed; "
                            "otherwise select `Change' and choose another drive "
                            "or delete some files." )
                    (help "No more help here")
                    (choices "Proceed" "Change")
                )
                (set space-ok 1)
            )
        )
    )
)

(message ("\n\nAbout to %s files to %s" g-msg @default-dest))

(if (not (exists @default-dest))
    (makedir @default-dest
        (infos)
    )
)

(set tmp ("Assign >NIL: PROTEXT: %s" @default-dest))
(startup "Protext"
    (prompt "\nAdding the following line to S:user-startup\n\n" tmp)
    (help @startup-help)
    (command tmp)
)

(set tmp (tackon @default-dest "Protext"))
(if (exists tmp)
    (
        (set xx (getversion tmp))
        (set hi (/ xx 65536))
        (if (<> hi 6)
            ( ; copy old ppds if exists non v6 protext
                (oldfilestuff)
            )
        )
    )
)

(set destpath @default-dest)
(set u-destpath @default-dest)

(askdisk
    (prompt (m_plsinsert progdisk))
    (help @askdisk-help)
    (dest progdisk)
)
(set u-srcpath (cat progdisk ":"))
(arnorcopydisk)
(copylib
    (source (cat progdisk ":libs/asl.library"))
    (dest "LIBS:")
)

(askdisk
    (prompt (m_plsinsert ppddisk))
    (help @askdisk-help)
    (dest ppddisk)
)
(set u-srcpath (cat ppddisk ":"))
(arnorcopydisk)

(askdisk
    (prompt (m_plsinsert dictdisk))
    (help @askdisk-help)
    (dest dictdisk)
)
(set u-srcpath (cat dictdisk ":"))
(arnorcopydisk)

(askdisk
    (prompt (m_plsinsert thesdisk))
    (help @askdisk-help)
    (dest thesdisk)
)
(set u-srcpath (cat thesdisk ":"))
(arnorcopydisk)

(run (cat "cd " @default-dest))
(run (tackon @default-dest "config") ("-i%s" @default-dest))